The Business Master (3rd Edition)

home *** CD-ROM | disk | FTP | other *** search

/ The Business Master (3rd Edition) / The Business Master (3rd Edition).iso / files / spreotus / 123fin / personal.bas (.txt) < prev next >

Wrap

GW-BASIC | 1980-01-01 | 9.9 KB | 373 lines

100 REM ------------------------------ 110 N$= "PERSONAL FILE" 120 REM ------------------------------ 130 GOSUB 6200 'INITIALIZE 140 X$(1)="ADD RECORD" 150 X$(2)="LIST FILE" 160 X$(3)="DELETE RECORD" 170 X$(4)="SEARCH FILE" 171 X$(5)="TERMINATE PROGRAM" 180 REM DECLARE NO. OF FIELDS AND NAMES 190 F$(1)="LAST NAME" 200 F$(2)="FIRST NAME" 210 F$(3)="TELEPHONE" 220 F$(4)="STREET ADDRESS" 230 F$(5)="CITY" 240 F$(6)="STATE" 250 F$(7)="ZIP" 260 NF=7 : F$="PERS.BAS" : FB$="PERS.BAK" 270 N=5 : GOSUB 7000 'DISPLAY MENU 271 IF X = 5 THEN RUN"MENU.BAT" 280 ON X GOSUB 690,470,750,830 290 GOTO 100 300 REM ------------------------------ 310 REM LIST RECORD ON PRINTER 320 REM ------------------------------ 330 LPRINT L;". ",P1$;", ";P2$ 340 LPRINT, P3$ 350 LPRINT, P4$ 360 LPRINT, P5$; ", ";P6$;" " P7$ 370 LPRINT 380 RETURN 390 REM ------------------------------ 400 REM LIST RECORD ON SCREEN 410 REM ------------------------------ 420 PRINT L;". ";,P1$;". ";P2$ 430 PRINT, P3$ 440 PRINT, P4$ 450 PRINT, P5$; ", ";P6$;" " P7$ 460 PRINT : RETURN 470 REM ------------------------------ 480 N$= "LIST FILE" 490 REM ------------------------------ 500 GOSUB 6200 'INITIALIZE 510 Q1$="OUTPUT TO PRINTER" 520 Q2$="" : Q3$="YES OR NO" 530 GOSUB 5000 'PRINT DIALOG 540 GOSUB 7800 'YESNO 550 CLS 560 OPEN F$ FOR INPUT AS #1 570 L=1 580 IF EOF(1) THEN 660 590 INPUT#1,P1$,P2$,P3$,P4$,P5$,P6$,P7$,P8$ 600 IF YN$="Y" THEN GOSUB 300 ELSE GOSUB 400 610 IF YN$="Y" THEN GOTO 640 620 FOR I1= 1 TO 100 'DELAY TO READ ON SCREEN 630 NEXT I1 640 L=L+1 650 GOTO 580 660 PRINT :PRINT : PRINT 670 GOSUB 7400 'PAUSE 680 CLOSE: RETURN 690 REM ------------------------------ 700 N$= "ADD RECORD" 710 REM ------------------------------ 720 REM CALL ADD RECORD SUBROUTINE 730 GOSUB 3000 740 RETURN 750 REM ------------------------------ 760 N$= "DELETE RECORD" 770 REM ------------------------------ 780 GOSUB 4600 'DELETE RECORD 790 IF L <> -1 THEN GOTO 810 800 LOCATE 19,1 : PRINT "RECORD NOT FOUND" 810 Q2$="DELETE" : GOSUB 3400 'ASK FOR ANOTHER 820 IF YN$="N" THEN RETURN ELSE 780 830 REM ------------------------------- 840 N$= "SEARCH FILE" 850 REM ------------------------------- 860 GOSUB 6200 : F=0 :L=0 870 Q1$="SEARCH FOR LAST NAME" 880 Q2$="" : Q3$="LAST NAME :" 890 GOSUB 5000 900 INPUT NA$ 910 OPEN F$ FOR INPUT AS #1 920 L=L+1 : IF EOF(1) THEN 990 930 INPUT#1,P1$,P2$,P3$,P4$,P5$,P6$,P7$,P8$ 940 IF P1$ <> NA$ THEN GOTO 920 'NO MATCH TRY AGAIN 950 F=1 'SET FOUND FLAG 960 LOCATE 5,1 : CLS : GOSUB 400 'DISPLAY REC ON SCRN 970 GOSUB 7400 'WAIT FOR KEY 980 GOTO 920 'LOOK FOR NEXT MATCH 990 REM OUT OF RECORDS 1000 CLOSE 1010 LOCATE 19,1 1020 IF F=0 THEN PRINT "NO MATCHES FOUND" 1030 Q2$="SEARCH" : GOSUB 3400 'ASK FOR ANOTHER 1040 IF YN$="N" THEN RETURN ELSE 830 3000 REM "ADREC" 3001 ' ------------------------------- 3002 ' ADD RECORDS TO FILE 3003 ' 3004 'THIS ROUTINE ADDS RECORDS TO A FILE 3005 ' 3006 'CALLING PARAMETERS: 3007 ' NF= NUMBER OF FIELDS IN RECORD (MAX=8) 3008 ' F$(L)=NAMES OF FIELDS 3009 ' F$=NAME OF FILE TO ADD TO 3010 ' 3011 'RETURNED PARAMETERS: 3012 ' NONE 3013 ' 3014 'COMMENT: ADDS RECORDS TILL TERMINATED BY USER 3015 ' & FIELDS ARE CREATED EVEN IF BLANK 3016 ' 3017 ' ------------------------------- 3020 OPEN F$ FOR APPEND AS #1 3030 K=1 : GOSUB 6200 'INITIALIZE 3040 Q1$="ENTER DATA" 3050 Q2$="" 3060 FOR L= 1 TO NF 3070 Q3$=F$(L) : GOSUB 5800 'ASK FOR DATA 3080 NEXT L 3090 WRITE#1,P$(1),P$(2),P$(3),P$(4),P$(5),P$(6),P$(7),P$(8) 3100 REM SEE IF MORE RECORDS TO BE ADDED 3110 Q1$="ADD ANOTHER RECORD ? " 3120 Q2$="" : Q3$="YES OR NO" 3130 GOSUB 5000 'PRESENT DIALOG 3140 GOSUB 7800 'YESNO 3150 IF YN$="Y" GOTO 3030 3160 CLOSE : RETURN 3400 REM "ANOTH" 3401 ' -------------------------------- 3402 ' ASK FOR ANOTHER RUN 3403 ' 3404 'THIS ROUTINE ASKS THE USER WHETHER TO CONTINUE 3405 ' 3406 'CALLING PARAMETERS: 3407 ' Q2$= STRING TO SPECIFY WHAT OPERATION TO DO 3408 ' 3409 'RETURNED PARAMETERS: 3410 ' YN$= A "Y" OR "N" FOR YES OR NO 3411 ' 3412 ' -------------------------------- 3420 Q1$="WOULD YOU LIKE TO " 3430 Q3$="AGAIN Y OR N ?" 3440 GOSUB 5000 'PRESENT DIALOG 3450 GOSUB 7800 'ASK YES OR NO 3460 RETURN 3800 REM "BAKFIL" 3801 ' ------------------------------- 3802 ' BACK UP A FILE 3803 ' 3804 'THIS ROUTINE CREATES A BACKUP COPY OF A FILE 3805 ' 3806 'CALLING PARAMETERS: 3807 ' F$= NAME OF FILE TO BACKUP 3808 ' FB$=NAME OF BACKUP FILE 3809 ' 3810 ' ------------------------------- 3820 OPEN F$ FOR INPUT AS #1 3830 OPEN FB$ FOR OUTPUT AS #2 3840 'READ A RECORD, THEN WRITE IT 3850 FOR I= 1 TO 4000 3860 IF EOF(1) THEN GOTO 3900 'TILL END OF FILE 3870 INPUT#1,P1$,P2$,P3$,P4$,P5$,P6$,P7$,P8$ 3880 WRITE#2,P1$,P2$,P3$,P4$,P5$,P6$,P7$,P8$ 3890 NEXT I 3900 CLOSE 3910 RETURN 4600 REM "DELREC" 4601 ' ------------------------------- 4602 ' DELETE RECORC 4603 ' 4604 'THIS ROUTINE DELETES A RECORD FROM A FILE 4605 ' 4606 'CALLING PARAMETERS: 4607 ' FB$= NAME OF BACKUP FILE TO CREATE 4608 ' F$=NAME OF FILE TO DELETE FROM 4609 ' 4610 'RETURNED PARAMETERS: 4611 ' L=-1 IF RECORD NOT FOUND 4612 ' 4613 'COMMENT-USER IS ASKED FOR RECORD NUMBER 4614 ' BACKUP FILE IS CREATED 4615 ' 4616 ' ------------------------------- 4620 N$="DELETE RECORD" : GOSUB 6200 'INITIALIZE 4630 Q1$="NUMBER OF RECORD TO DELETE" 4640 Q2$="" : Q3$="" 4650 GOSUB 5000 'ASK QUESTION 4660 INPUT L 'GET REC NUMBER 4670 GOSUB 3800 'CREATE BACKUP 4680 OPEN FB$ FOR INPUT AS #1 4690 OPEN F$ FOR OUTPUT AS #2 4700 FOR I = 1 TO L-1 4710 IF EOF(1) THEN GOTO 4860 'REC NOT FOUND 4720 INPUT#1,P1$,P2$,P3$,P4$,P5$,P6$,P7$,P8$ 4730 WRITE#2,P1$,P2$,P3$,P4$,P5$,P6$,P7$,P8$ 4740 NEXT I 4750 REM READ BUT DON'T WRITE RECORD TO DELETE 4760 INPUT#1,P1$,P2$,P3$,P4$,P5$,P6$,P7$,P8$ 4770 REM READ AND WRITE TILL END OF FILE 4780 FOR I= 1 TO 4000 4790 IF EOF(1) THEN GOTO 4840 4800 INPUT#1,P1$,P2$,P3$,P4$,P5$,P6$,P7$,P8$ 4810 WRITE#2,P1$,P2$,P3$,P4$,P5$,P6$,P7$,P8$ 4820 NEXT I 4830 REM NORMAL RETURN 4840 CLOSE : RETURN 4850 REM ERROR RETURN 4860 CLOSE 4870 L=-1 'SET ERROR FLAG 4880 RETURN 5000 REM "DIALOG" 5001 ' ------------------------------- 5002 ' DIALOGUE 5003 ' 5004 'CALLING PARAMETERS: 5005 ' Q1$,Q2$,Q3$, = QUESTIONS TO DISPLAY 5006 ' 5007 'RETURNED PARAMETERS: 5008 ' NONE 5009 ' 5010 'COMMENT: UNUSED QUESTION STRINGS SHOULD BE SET 5011 ' TO NULL ("") 5012 ' 5013 ' ------------------------------- 5020 FOR I= 20 TO 23 5030 LOCATE I,1 5040 IF I > 20 THEN 5080 5050 FOR J= 1 TO 40 'DRAW A BORDER 5060 PRINT "-"; 5070 NEXT J 5080 IF I = 21 THEN PRINT Q1$; 'FIRST QUESTION 5090 IF I = 22 THEN PRINT Q2$; 'SECOND QUESTION 5100 IF I = 23 THEN PRINT Q3$; 'THIRD QUESTION 5109 REM RESTORE CURSOR HERE AFTER 3RD QUEST 5110 CP1=POS(N) 5120 CP=POS(N) 'CURSOR COLUMN POSITION 5130 IF CP>40 THEN 5150 5140 PRINT " "; : GOTO 5120 'ERASE ANY PRIOR INFO 5149 REM RESTORE CURSOR FOR USER RESPONSE 5150 LOCATE I,CP1 5160 NEXT I 5170 RETURN 5400 REM "INCH" 5401 ' ------------------------------ 5402 ' INPUT CHARACTER 5403 ' 5404 'CALLING PARAMETERS: 5405 ' NONE 5406 ' 5407 'RETURNED PARAMETERS: 5408 ' CH$=INPUT CHARACTER 5409 ' 5410 ' ------------------------------ 5420 REM WAIT FOR INPUT CHARACTER 5430 CH$= INKEY$ : IF CH$="" THEN 5430 5440 Z=ASC(CH$) 5450 IF Z < 97 OR Z > 122 THEN 5470 5460 Z=Z-32 5470 CH$=CHR$(Z) 5480 RETURN 5800 REM "INDAT" 5801 ' ------------------------------- 5802 ' INPUT DATA 5803 ' 5804 'CALLING PARAMETERS: 5805 ' Q1$,Q2$= USER INSTRUCTIONS 5806 ' Q3$=NAME OF DATA ITEM 5807 ' 5808 'RETURNED PARAMETERS: 5809 ' P$(K)=ARRAY OF DATA ITEMS 5810 ' 5811 'COMMENT:ONE ITEM AT A TIME IS INPUT 5812 ' FIRST CALL IS WITH K=1 5813 ' K UPDATED AUTOMATICALLY 5814 ' 5815 '--------------------------------- 5820 GOSUB 5000 'ASK QUESTIONS 5830 INPUT P$(K) 'GET DATA 5840 REM ECHO QUESTION AND ANSWER 5850 LOCATE K+2,3 5860 PRINT Q3$;TAB(25);P$(K) 5870 K=K+1 'UPDATE INDEX 5880 RETURN 6200 REM "INIT" 6201 '---------------------------------- 6202 ' INITIALIZE DISPLAY 6203 ' 6204 'THIS ROUTINE CLEARS THE SCREEN 6205 ' AND PRINTS THE PROGRAM TITLE 6206 'CALLING PARAMETERS: 6207 ' N$=TITLE OF PROGRAM 6208 ' 6209 'RETURNED PARAMETERS: 6210 ' NONE 6211 ' 6212 ' ---------------------------------- 6220 CLS 'CLEAR SCREEN 6230 PRINT N$ : PRINT 'TITLE 6240 KEY OFF 6250 RETURN 7000 REM "MENU" 7001 ' ------------------------------ 7002 ' MENU PROGRAM 7003 ' 7004 'THIS PROGRAM DISPLAYS A MENUE 7005 ' AND CHOOSES A PROGRAM 7006 'CALLING PARAMETERS: 7007 ' N= NO. OF MENU ITEMS 7008 ' X$(I)= ARRAY OF PROGRAM NAMES 7009 ' 7010 'RETURNED PARAMETERS: 7011 ' X=PROGRAM NUMBER CHOSEN 7012 ' 7013 ' ------------------------------ 7020 CLS 7030 FOR I = 1 TO N 'DISPLAY MENU 7040 IF I=10 THEN PRINT 0; ELSE PRINT I; 7050 PRINT "= " ; X$(I) 7060 NEXT I 7070 Q1$="" : Q2$="" 7080 Q3$="CHOOSE PROGRAM :" 7090 GOSUB 5000 'ASK QUESTIONS 7100 GOSUB 5400 'INPUT CHAR 7110 X= VAL(CH$) 7119 REM SEE IF CHAR IN RANGE 7120 IF X>=1 AND X<=N THEN RETURN 7130 IF X=0 AND N=10 THEN 7140 ELSE 7150 7140 X=10 : RETURN 7150 Q1$="ILLEGAL CHOICE, CHOOSE AGAIN" 7160 GOSUB 5000 7170 GOTO 7100 7400 REM "PAUSE" 7401 ' ------------------------------- 7402 ' WAIT FOR ANY KEY 7403 ' 7404 'THIS ROUTINE WAITS FOR USER TO STRIKE KEY 7405 ' 7406 'CALLING PARAMETERS: 7407 ' NONE 7408 ' 7409 'RETURNED PARAMETERS 7410 ' NONE 7411 ' 7412 ' ------------------------------- 7420 Q1$="STRIKE ANY KEY TO CONTINUE" 7430 Q2$="" : Q3$="" 7440 GOSUB 5000 'CALL DIALOG 7450 X$=INKEY$ : IF X$ = "" THEN 7450 'WAIT FOR KEY 7460 RETURN 7800 REM "YESNO" 7801 ' ------------------------------- 7802 ' YES-NO 7803 ' 7804 'CALLING PARAMETERS: 7805 ' NONE 7806 ' 7807 'RETURNED PARAMETERS: 7808 ' YN$= CONTAINS A Y OR N 7809 ' 7810 ' ------------------------------- 7815 LOCATE 24,24:PRINT "F10 to EXIT program. 7820 REM WAIT FOR KEY TO BE STRUCK 7830 YN$=INKEY$ : IF YN$="" THEN 7830 7840 IF YN$="y" THEN YN$="Y" 7850 IF YN$="n" THEN YN$="N" 7860 IF YN$ = "Y" OR YN$ = "N" THEN 7890 7870 REM NOT YES OR NO TRY AGAIN 7880 GOTO 7830 7890 PRINT YN$ : RETURN